home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / samples / business.prg < prev    next >
Encoding:
Text File  |  1993-03-09  |  3.8 KB  |  130 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: BUSINESS.PRG
  3. *               MAIN MENU
  4. *               SAMPLE BUSINESS APPLICATION SYSTEM
  5. * LAST CHANGED: 06/20/90 08:00AM
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8.  
  9. PROCEDURE Business
  10.    * Link to external procedure file of "tool" procedures
  11.    SET PROCEDURE TO Library
  12.  
  13.    CLEAR ALL
  14.    DO Set_env
  15.    PUBLIC gl_MainMenu                   && Indicate to the sub-applications
  16.                                         && that the Main menu called them
  17.  
  18.    * Define help key
  19.    ON KEY LABEL F1 DO Helper
  20.  
  21.  
  22.    * Set display characteristics - depends on hardware
  23.    IF ISCOLOR()
  24.       c_normal = "W+/B,GR+/R,B"
  25.       c_pop    = "B/W,GR+/R,W+/R"
  26.       red      = "R/W"
  27.       blue     = "B/W"
  28.       lt_blue  = "W/BG"
  29.    ELSE
  30.       STORE "W+/N,N/W" TO c_normal, c_pop
  31.       STORE "W"   TO red, blue
  32.       STORE "N/W" TO lt_blue
  33.    ENDIF
  34.  
  35.    * Define popup
  36.    DO Main_def
  37.  
  38.    * Display menu and loop for choices
  39.    **mstrloop = .T.
  40.    PUBLIC gl_Error
  41.    gl_Error = .F.
  42.    DO WHILE BAR() <> 13 .AND. .NOT. gl_Error
  43.       SET COLOR TO &c_normal.
  44.       CLEAR
  45.       DO Title
  46.       SET COLOR TO &c_pop.
  47.       ACTIVATE POPUP mainmenu
  48.       DO Main
  49.    ENDDO
  50.    RELEASE gl_MainMenu                  && Allow Rest_env to reset the
  51.    DO Rest_env                          && environment back.
  52.    ON ERROR
  53.    ON KEY LABEL F1 
  54.    CLEAR ALL
  55.    CLOSE ALL
  56.    CLEAR
  57.  
  58. RETURN
  59. *** END MAIN PROCEDURE *******************************************************
  60.  
  61. PROCEDURE Title
  62.    CLEAR
  63.    * Draw lines and box for menu with colors for effect
  64.    @ 2,24 TO 5,53 DOUBLE COLOR &blue.
  65.    @ 2,24 FILL TO 5,53   COLOR &blue.
  66.    SET COLOR TO &red.
  67.    @ 3,27 SAY "A-T FURNITURE INDUSTRIES"
  68.    @ 4,26 SAY "dBASE IV ACCOUNTING SYSTEM"
  69.    SET COLOR TO &c_normal.
  70. RETURN
  71.  
  72. PROCEDURE Main_def
  73.    * Defines the main popup menu
  74.    DEFINE POPUP mainmenu FROM 7,27 TO 22,50;
  75.      MESSAGE "Press first letter of menu choice, " + ;
  76.              "or highlight and press <Enter>"
  77.    DEFINE BAR  1 OF mainmenu PROMPT "===== MAIN  MENU =====" SKIP
  78.    DEFINE BAR  2 OF mainmenu PROMPT "      Databases:" SKIP
  79.    DEFINE BAR  3 OF mainmenu PROMPT " EMPLOYEES"
  80.    DEFINE BAR  4 OF mainmenu PROMPT " CUSTOMERS"
  81.    DEFINE BAR  5 OF mainmenu PROMPT " VENDORS"
  82.    DEFINE BAR  6 OF mainmenu PROMPT " INVENTORY"
  83.    DEFINE BAR  7 OF mainmenu PROMPT " ORDERS"
  84.    DEFINE BAR  8 OF mainmenu PROMPT " ACCOUNTS RECEIVABLE"
  85.    DEFINE BAR  9 OF mainmenu PROMPT " AREA CODES"
  86.    DEFINE BAR 10 OF mainmenu PROMPT "     Utilities:" SKIP
  87.    DEFINE BAR 11 OF mainmenu PROMPT " PRINT INVOICES"
  88.    DEFINE BAR 12 OF mainmenu PROMPT " BACK UP/RESTORE DATA"
  89.    DEFINE BAR 13 OF mainmenu PROMPT " RETURN TO dBASE"
  90.    DEFINE BAR 14 OF mainmenu PROMPT " QUIT TO DOS"
  91.    ON SELECTION POPUP mainmenu DEACTIVATE POPUP
  92. RETURN
  93.  
  94. PROCEDURE Main
  95.    * Execute case depending on user's choice
  96.    DO CASE
  97.       CASE BAR() =  3
  98.          DO Employee
  99.       CASE BAR() =  4
  100.          DO Cust
  101.       CASE BAR() =  5
  102.          DO Vendors
  103.       CASE BAR() =  6
  104.          DO Goods
  105.       CASE BAR() =  7
  106.          DO Orders
  107.       CASE BAR() =  8
  108.          DO Acct_rec
  109.       CASE BAR() =  9
  110.          DO Areacode
  111.       CASE BAR() =  11
  112.          DO Invoices
  113.       CASE BAR() =  12
  114.          DO Back_res
  115.       CASE BAR() =  13 .OR. BAR() = 14
  116.          RELEASE ALL
  117.          IF BAR() = 13
  118.             SET CLOCK ON
  119.               * Reset colors to Control Center/dot prompt colors
  120.               DO Colo_rese
  121.             RETURN TO MASTER
  122.          ELSE
  123.             QUIT
  124.          ENDIF
  125.    ENDCASE
  126. RETURN
  127.  
  128. *** END BUSINESS.PRG *********************************************************
  129. 
  130.